perm filename LOOP.FAI[NEW,LCS]2 blob sn#153826 filedate 1975-04-09 generic text, type T, neo UTF8
	TITLE LOOP	;	SUBROUTINE LOOP(I,J,L,M,N)
	ENTRY LOOP,FINDIT,PLACE,DPYNEW,MVBEAM,MVBX,JUGGLE,XNOTE,BAUTO
	ENTRY	SORT2,UPDATE,NEWR
	EXTERNAL ACCPOG,DPYOUT,.COMM.,XRN,AMOD,PTR,KJY,DPY,DL,SCM
	EXTERNAL SC,SCX
	DEFINE FIXX(N)
<	JUMPGE	N,.+5
	MOVNS	N
	FIX 	N,233000    
	MOVNS	N
	CAIA
	FIX	N,233000 >	; TO FIX IT LIKE 'IFIX' DOES.
			;	DIMENSION N(1)
	MM←1 ↔ NN←2 ↔ J←3
LOOP:	0		;	DO 1 NN=I+L,J+L,K
	MOVE	1,@4(16)
	SUB 	1,@3(16) 	; MM IS IN 1
	MOVE	2,@(16)
	ADD	2,@3(16)	;I+L  -- NN, 1ST TIME
	MOVE	3,@1(16)
	ADD	3,@3(16)	;J+L
	MOVE	4,@2(16)	;K
	HRRZI	5,@5(16)		; ADR. OF N
	ADDI	2,-1(5)		; N(NN)
	ADDI	3,-1(5)
	JUMPL	4,LP3		; JUMP IF NEG. INCR.
	HRRM	1,.+1		; ADD IN MM 
LP1:	MOVE	6,(2)
	MOVEM	6,(2)		;N(NN)=N(NN+MM)
	CAIGE	2,(3)
	AOJA	2,LP1
	JRA	16,6(16)
LP3:	HRRM	1,.+1
LP2:	MOVE	6,(2)		;NEG. INCR.
	MOVEM	6,(2)
	CAILE	2,(3)
	SOJA	2,LP2
	JRA 	16,6(16)	;	END

PLACE:	0	;	FUNCTION PLACE(X)
;	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/XRN/RN(4000)
;	EQUIVALENCE (R11,RJQ(9)),(RD,RN(4000))
	MOVN	2,@(16) ;	PLACE=R11-ABS(RD-X)
	FADR	2,XRN+=3999 	;END
	MOVMS	2
	MOVE 	0,.COMM.+=12	;R11
	FSBR	0,2
	JRA	16,1(16)

FINDIT:	0    ;	FUNCTION FINDIT(N)
	SETZ   ;	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
	HRRZ	1,@(16) ; COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
	HRRZI	2,PTR  ;	FINDIT=0
	ADDI	1,(2)  ;	L=PWDS(N)
	MOVE	2,-1(1) ;	IF(RN(L+1).NE.1)GO TO 377
	FIXX(2)         ;	IF(RN(L+2).EQ.R2)RETURN
	MOVEM	2,PTR+=251   ; SENDS BACK A NUM IN L
	HRRZI	3,XRN     ;377	FINDIT=-1
	ADDI	3,(2)   ;	END
	MOVE 5,(3)   ; RN(L+1)
	CAME	5,[1.0]
	JRST	FNEG
	MOVE	5,1(3)  ;RN(L+2)
	CAME	5,.COMM.
FNEG:	SETO
	JRA	16,1(16)

DPYNEW:	0    ;	SUBROUTINE DPYNEW
	JSA	16,ACCPOG    ; COMMON/DPY/ST(4000),WDS(250),MEDIT,IGO
	JUMP	[1]    ;	CALL ACCPOG(1)
	MOVE	2,DPY+=4251    ;	IF(IGO.GT.0)RETURN
	JUMPG	2,DB    ;	CALL DPYOUT(1)
	JSA	16,DPYOUT    ;	END
	JUMP	[1]
DB:	JRA	16,(16)

MVBEAM:	0  ;C  THESE MOVE ENDS OF PARTIAL INNER BEAMS.
	HRRZ	2,(16) ;	SUBROUTINE MVBEAM(R,I,JY,L,W)
	MOVE	5,@1(16)  ; I
	ADD	2,5  ;C  L AND JY ARE FOR MOVES TO DIFF. STAFF.
	ADD	2,@2(16)  ;	DIMENSION R(1)
	MOVE	3,-1(2)  ;	Y=R(JY+I)
	MOVM	4,3   ;	Z=ABS(Y)
	CAMGE	4,[=100.0]  ;	IF(Z.LT.100.)GO TO 1
	JRST	MV1
	CAML	5,[6]
	JRST	MV1	;  IF(I.GT.5)GO TO 1
;C  NEXT FOR MINIS, DIAMONDS, 'X' NOTES. (LIMIT OF +-99 ON ALTITUDE.)
	JSA	16,AMOD  ;	Y=AMOD(Y,100.)
	JUMP	3  
	JUMP	[=100.0]  ; 0 HAS Y
	MOVE	5,@4(16)  ;	X=Y+W
	FADR	5,0
	MOVM	6,5  ;	Z=Z-ABS(Y)+ABS(X)
	MOVM	7,0 ;C  PUTS ALL INTO POSITIVE
	FSBR	4,7
	FADR	4,6
	SKIPGE 	5  ;	IF(X)Z=-Z
	MOVNS	4    ; Z
	JRST 	MV2 ;	GO TO 2
MV1:	FADR	3,@4(16)  ;1	Z=Y+W
	MOVE	4,3   ; Z NOW IN 4
MV2:	HRRZI	3,@(16) ;2	R(L+I)=Z
	ADD	3,@3(16)
	ADD	3,@1(16)
	MOVEM	4,-1(3)  ; PUT IT IN R(L+I)
	JRA	16,5(16)	; END

MVBX:	0   ;	SUBROUTINE MVBX(I)
;     COMMON R2,JA,CENTR,J2,RJQ(20),L,RDIS,JQ(18)/KJY/K,JY/XRN/R(4000)
	MOVE	2,@(16)  ;	EQUIVALENCE (R4,RJQ(2)),(R8,RJQ(6))
	ADD	2,KJY+1 ;	R(L+I)=R8+(R(JY+I)-R4)*RDIS
	HRRZI	4,XRN
	ADDI	2,(4)
	MOVE	3,-1(2)  ; R(JY+I)
	FSBR	3,.COMM.+5
	FMPR	3,.COMM.+=25  ; *RDIS
	FADR	3,.COMM.+=9   ; +R8
	MOVE	2,@(16)
	ADD	2,.COMM.+=24   ; + L
	ADDI	2,(4)
	MOVEM	3,-1(2)    ;R(L+I)
	JRA	16,1(16)

JUGGLE:	0    ;	SUBROUTINE JUGGLE
;	IMPLICIT INTEGER(A-Z)
;	REAL PWDS,RN
;	COMMON /DL/X22,SAVER,NAME /XRN/RN(4000)
;     COMMON/PTR/PWDS(250),ITEM,L,I,IX/DPY/ST(4000),WDS(250),MEDIT,IGO
	SOS	PTR+=250	;ITEM=ITEM-1
	HRRZI	15,XRN	;	JX=RN(MEDIT)+3   WD CNT OF OLD ITEM
;C  I-IX IS WD CNT OF NEW ITEM
	ADD	15,DPY+=4250
	MOVE	14,-1(15)
	FIXX(14)
	ADDI	14,3  		; JX
	MOVE	13,PTR+=253	;JY=IX
	MOVE	11,PTR+=252	; I
	SUB	11,13
	SUB	11,14		;Z=I-IX-JX    SPACE CHANGE
	JUMPL	11,J2751   	;IF(Z)2751,172,751
	JUMPE	11,J172
	MOVE	5,PTR+=252 ;751   CALL LOOP(I-1,MEDIT+JX,-1,Z,0,RN)
	SUBI	5,1
	MOVE	10,DPY+=4250
	ADD	10,14
	JSA	16,LOOP
	JUMP	5
	JUMP	10
	JUMP	[-1]
	JUMP	11
	JUMP	[0]
	JUMP	XRN
	ADD	13,11		;JY=IX+Z
	JRST	J172		;GO TO 172
J2751:	ADD	14,DPY+=4250 ;2751  CALL LOOP(MEDIT+JX+Z,IX+Z-1,1,0,-Z,RN)
	ADD	14,11
	MOVE	5,11
	ADD	5,PTR+=253
	SOS	5
	MOVN	10,11
	JSA	16,LOOP
	JUMP	14
	JUMP	5
	JUMP	[1]
	JUMP	[0]
	JUMP	10
	JUMP	XRN
J172:	HRRZI	12,XRN 		;  172	J=RN(JY)+2
	ADDI	12,(13) 		; JY
	MOVE	12,-1(12) 	;RN(JY)
	FIXX(12)
	ADDI	12,2		; J IS IN 12
	JSA	16,LOOP		;CALL LOOP(0,J,1,MEDIT,JY,RN)
	JUMP	[0]
	JUMP	12
	JUMP	[1]
	JUMP	DPY+=4250	; MEDIT
	JUMP 	13		; JY
	JUMP	XRN
	MOVE	12,PTR+=253	; I=IX+Z
	ADD	12,11		; Z IS IN 11
	MOVEM	12,PTR+=252
	MOVE	12,PTR+=250  	; 1751	X=ITEM+1
	ADDI	12,1	    	; X IS IN 12
	HRRZI	13,DPY+=4000   	; JX=WDS(X22+1)-WDS(X22)
	ADD	13,DL	
	MOVE	14,(13)   	; WDS(X22+1) IN 14  ADR. WDS(X22) IN 13
	SUB  	14,-1(13)	;JX IN 14
	HRRZI	10,DPY+=4000     	;  J=WDS(X+1)-WDS(X)
	ADDI	10,(12)
	MOVE	7,(10)		;WDS(X+1)
	SUB	7,-1(10)		;J IN 7
	MOVEM	7,MVBX		; STORE J
	SUB	7,14    	; Y=J-JX
	MOVE	14,-1(10)  	;  JX=WDS(X)+Y+1
	ADD	14,7
	ADDI	14,1		; JX IN 14
	JUMPL	7,J2851   	;  IF(Y)2851,182,282
	JUMPE	7,J182
	MOVE	15,(10) ;282  CALL LOOP(WDS(X+1)+2,WDS(X22),-1,Y,0,ST)
	ADDI	15,2	  	; ARG 1
	MOVE	6,-1(13) 	;  ARG 2
	JSA	16,LOOP
	JUMP	15
	JUMP	6 
	JUMP	[-1]
	JUMP	7	  	; Y
	JUMP	[0]
	JUMP	DPY
	JRST	J182   		;  GO TO 182
J2851:	MOVE	14,(13) ;2851  CALL LOOP(WDS(X22+1)+Y+1,WDS(X)+Y+1,1,0,-Y,ST)
	ADD	14,7		;+Y
	ADDI	14,1		; ARG 1
	MOVE	5,-1(10) 	;WDS(X)
	ADD	5,7
	ADDI	5,1		; ARG 2
	MOVNM	7,MVBEAM	; -Y IS STORED
	JSA	16,LOOP
	JUMP	14
	JUMP	5
	JUMP	[1]
	JUMP	[0]
	JUMP	MVBEAM
	JUMP	DPY
	MOVE	14,-1(10)  	; WDS(X)   JX=WDS(X)+1
	ADDI	14,1		; JX IN 14
J182:	MOVE	5,-1(13)  ;182	CALL LOOP(1,J,1,WDS(X22)+1,JX,ST)
	ADDI	5,1   	;WDS(X22)+1
	JSA	16,LOOP
	JUMP	[1]
	JUMP	MVBX
	JUMP	[1]
	JUMP	5  
	JUMP	14 
	JUMP	DPY
	MOVE	2,DL    	; DO 183 K=X22+1,X
;;	HRRZI	5,DPY+=4000  	; 183	WDS(K)=WDS(K)+Y
;;	ADD	5,2
	HRRZI	3,PTR
	ADDI	3,(2)
	TLC	11,232000	; FLOAT Z
	FADR	11,11
J183:	JUMPE	11,J184		;IF(Z.EQ.0)GO TO 184
	MOVE	4,(3)
	FADR	4,11		; ADD Z
	MOVEM	4,(3)		; PWDS(K)=PWDS(K)+Z
	ADDI	3,1	;UPDATE PWDS AND WDS
J184:	JUMPE	7,J185
	MOVE	6,(13)
	ADD	6,7
	MOVEM	6,(13)
	ADDI	13,1
J185:	CAIGE	2,(12)
	AOJA	2,J183
	HRRZI	2,DPY+=4000	;ST(2)=WDS(X)
	ADDI	2,(12)		;WDS(X+1) ADR.
	MOVE	2,-1(2)
	HRRZI	3,DPY
;;	AOJ	3,
	MOVEM	2,1(3)
	SETZM	DL		;X22=0
	JRA	16,(16)

SORT2:	0		;SUBROUTINE SORT2(RPOS,M)
	MOVEI	2,2	;DIMENSION RPOS(2,200)
S3:	MOVE	6,2	;(K=L HERE)
	SETO	11,	;L=2
	HRRZI	3,@(16)	;3	J=-1
	MOVE	4,2	;RX=RPOS(1,L-1)
	SUBI	4,1	;L-1
	IMULI	4,2
	ADDI	4,(3)
	MOVE	5,-2(4)	;RX
S2:	MOVE 	7,6	;	DO 2 K=L,M
;;	LSH	7,1	;IF(RPOS(1,K).GE.RX)GO TO 2
	IMULI	7,2	;IF(RPOS(1,K).GE.RX)GO TO 2
	ADDI	7,(3)
	CAMG	5,-2(7)
	JRST	S1	; CONTINUE
	MOVE	5,-2(7)	;  RX=RPOS(1,K)
;;C   WHY WERE ALL THE RX'S  JX ????? 9/6/73
	MOVE 	11,6	;J=K
S1:	CAMGE	6,@1(16)	;2	CONTINUE
	AOJA	6,S2
	JUMPL	11,S4	;IF(J)GO TO 4
	MOVE	12,2	;K=L-1
	SOS	12
	IMULI	12,2	;(K*2)
	ADD	12,3	;CALL EXCH(RPOS(1,K),RPOS(1,J))
	MOVE	10,-2(12)
;;	LSH	11,1		;MULTS BY 2 (LEFT SHIFT)
	IMULI	11,2
	ADD	11,3
	EXCH	10,-2(11)
	MOVEM	10,-2(12)
	MOVE	10,-1(12)	;CALL EXCH(RPOS(2,K),RPOS(2,J))
	EXCH	10,-1(11)
	MOVEM	10,-1(12)
S4:	CAMGE	2,@1(16)	;4	L=L+1
	AOJA	2,S3		;IF(L.LE.M)GO TO 3
	JRA	16,2(16)	;END

XNOTE:	0		;FUNCTION XNOTE(J)
	MOVE 	3,@(16)		;COMMON/XRN/RN(4000)
	IMULI	3,12		;DIMENSION R(10,80)
	ADDI	3,XRN+=2993	;EQUIVALENCE (R,RN(3001))
	MOVE	2,(3)		;XNOTE=AMOD(R(4,J),100.)
	JSA	16,AMOD
	JUMP	2
	JUMP	[=100.0]
	JRA	16,1(16)	;END

BAUTO:	0		;	SUBROUTINE BAUTO(J,L,K,N)
	MOVE	2,@(16)		;C  FOR AUTOMATIC BEAMS.
	ADDI	2,2  	;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
	MOVEM	2,@(16)		;J=J+2
	MOVE	3,@3(16)
	MOVE	4,@1(16)
	SUB	4,3		;L-N
	MOVE	5,@2(16)
	SUB	5,3		;K-N
	HRRZI	6,SCM
	ADDI	6,(2)
	TLC	4,232000
	FADR	4,4		;FLOATS IT
	MOVEM	4,-2(6)		;V(J-1)=L-N
	TLC	5,232000
	FADR	5,5		;FLOATS IT
	MOVEM	5,-1(6)		;V(J)=K-N
	JRA	16,4(16)

UPDATE:	0	;	SUBROUTINE UPDATE(I)
	HRRZI	3,XRN  ;COMMON /PTR/PWDS(250),ITEM,LL,IS,IX /XRN/RN(4000)
	ADD	3,PTR+=252	;RN(IS)=I
	MOVE	2,@(16)
	TLC	2,232000	;FLOAT I
	FADR	2,2
	MOVEM	2,-1(3)
	MOVE	2,PTR+=252
	ADD	2,@(16)
	ADDI	2,3
	MOVEM	2,PTR+=252	;IS=IS+I+3
	JRA	16,1(16)

JK←3 ↔JT←4 ↔IEND←5 ↔A←6 ↔K←7↔ IS←10↔ IZ←11↔ R←12↔ L←13
IK:	0
JIT:	0  ; THESE ARE TO STORE PNTRS IN LOOP
NEWR:	0	;	SUBROUTINE NEWR
	MOVE	A,SC+=70	;COMMON/PTR/PWDS(250),ITEM,LL,IS,IX
	CAIE	A,1		;COMMON/XRN/RN(4000)
	JRST	N1	;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
	MOVE JK,PTR+=252;COMMON/SCX/RHY(4),JALPHA(20),JX,U,JZ,IRHY,J4,KA,KB,IZ
	MOVEM JK,IK  ;1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
	MOVE JT,PTR+=250  ;1 ,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
 	MOVEM	JT,JIT  	;DIMENSION R(10,80)	
N1:	MOVE	IS,IK		;EQUIVALENCE (R,RN(3001))
	MOVEM	IS,PTR+=252
	MOVE 	JT,JIT		;IF(MODE.NE.1)GO TO 1
	ADDI	JT,1		;IK=IS
	MOVEM	JT,PTR+=250	;JIT=ITEM
	MOVEI	K,=10		;1	IS=IK
	MOVE	IZ,SCX+=31	;ITEM=JIT+1
	IMULI	IZ,=10 ;MODE 1=NOTE, 2=RHYTH, 3=ACCENTS, 4=BEAMS, 5=SLURS.
N2:	HRRZI	R,XRN+=2997	;DO 2 K=1,IZ
	ADD	R,K		;IF(R(8,K).EQ.9999.)GO TO 2
	MOVE	R,(R)
	CAMN	R,[=9999.0]
	JRST	NN2  ;SKIPS INVIS RESTS - ONLY NEEDED IN RHYTH.
	SETO	IEND,		;C  JUMP FOR BEAM CONT.
	HRRZI	L,XRN		;IEND=-1
	ADD	L,PTR+=252	;RN(IS+3)=0
	SETZM	2(L)
	SETZM	1(L)		;RN(IS+2)=0
	MOVEI	L,=9 ;C  ↑↑↑↑ TO CLEAR ARRAY FOR SHORT ITEMS (CLEFS)
N3:	HRRZI	R,XRN+=3000	;DO 3 L=9,1,-1
	ADDI	R,(K)		;A=R(L,K)
	ADDI	R,(L)
	MOVE	A,-13(R)	;(OCTAL)=-11
	JUMPGE	IEND,NX4	;IF(A.NE.0)GO TO 77
	JUMPN	A,NX3		;IF(IEND)GO TO 3
	JRST	NN3
NX3:	MOVE	IEND,L		;77	IF(IEND)IEND=L
NX4:	HRRZI	R,XRN
	ADD	R,PTR+=252	;RN(IS+L)=A
	ADDI	R,(L)
	MOVEM	A,-1(R)
NN3:	CAILE	L,1		;3	CONTINUE
	SOJA	L,N3
	CAIGE	IEND,3
	MOVEI	IEND,3
	MOVE	15,IEND		;IF(IEND.LT.3)IEND=3
	SUBI	15,2
	JSA 	16,UPDATE	;CALL UPDATE(IEND-2)
	JUMP	15
NN2:	CAML	K,IZ		;2	CONTINUE
	JRA	16,(16)		;END
	ADDI	K,=10
	JRST	N2

	END